; =================================================
; load nth element from stream
(defun load-nth-from-file (file-name pos &optional eof-mark)
  (with-open-file (in-stream file-name
                             :direction :input
                             :if-does-not-exist :error)
    (loop for expr = (read in-stream nil eof-mark)
          for expr-pos from 0
          when (or (eq expr eof-mark) (= expr-pos pos))
          return expr)))

; =================================================
; type description
(defstruct type-desc
  (id nil :type symbol))

; =================================================
; make void typedesc
(defvar *void-typedesc* (make-type-desc :id 'void))
(defun make-void-type-desc ()
  *void-typedesc*)

; =================================================
; argument
(defstruct argument-pair
  (name) ; nil or symbol
  (type nil :type type-desc))

; =================================================
; function decl
(defstruct func-decl
  (return-type nil :type type-desc)
  (args nil :type cons))

; =================================================
; context structure
(defstruct analyzer-context
  (marks nil :type hash-table)
  (types nil :type hash-table)
  (funcs nil :type hash-table)
  (forwards nil :type hash-table))

; =================================================
; default context structure constructor
(defun make-empty-analyzer-context ()
  (make-analyzer-context
    :marks (make-hash-table)
    :funcs (make-hash-table)
    :types (make-hash-table)
    :forwards (make-hash-table)))

; =================================================
; register mark
(defun accept-forwarded-mark (mark-decl context)
  (unless (= 1 (length mark-decl))
    (error "mark declaration shall contain only one symbol"))
  (let ((mark (car mark-decl))
        (marks-table (analyzer-context-marks context)))
        (unless (symbolp mark)
          (error "mark is not a symbol"))
        (unless (null (gethash mark marks-table))
          (error "mark has already been defined"))
        (setf (gethash mark marks-table) 1)
        (format t "defining mark: ~a~%" mark)))

; =================================================
; register type
(defun accept-forwarded-type (type-decl context)
  (unless (= 1 (length type-decl))
    (error "type declaration shall contain only one symbol"))
  (let ((tp (car type-decl))
        (types-table (analyzer-context-types context)))
        (unless (symbolp tp)
          (error "type declaration is not a symbol"))
        (unless (null (gethash tp types-table))
          (error "type has already been defined"))
        (setf (gethash tp types-table) 1)
        (format t "defining type: ~a~%" tp)))

; =================================================
; retrieves element at the given position or signals error
;(defmacro t-nth (src-list arg-pos expected-type)
;  (if (listp expected-type)
;  `(let ((arg (nth src-list))
;         (if )))))
(defmacro checked-nth (pos src-list expected-type)
  `(let ((result (nth ,pos ,src-list)))
     (unless (typep result ,expected-type)
       (error "unexpected type"))
     result))

; =================================================
; convert to arguments list
(defun accept-arglist (arg-list)
  (error "not impl"))

; =================================================
; register function
(defun accept-forwarded-func (func-decl context)
  (unless (= 2 (length func-decl))
    (error "func declaration expects function name and arguments list"))
  (let ((funcs-table (analyzer-context-funcs context))
        (func-name (checked-nth 0 func-decl 'symbol))
        (f (make-func-decl
             :return-type (make-void-type-desc)
             :args (checked-nth 1 func-decl 'cons))))
    (setf (gethash func-name funcs-table) f)
    (format t "forwarded function ~a with arglist ~a~%" func-name (func-decl-args f))))

; =================================================
; handle forwarded tokens
(defun accept-forwards (f context)
  (dolist (fwd-decl f)
    (unless (listp fwd-decl)
      (error "forward declaration shall be a list"))
    (let ((fwd-type (car fwd-decl))
          (fwd-expr (cdr fwd-decl)))
      (cond
        ((eq fwd-type 'mark) (accept-forwarded-mark fwd-expr context))
        ((eq fwd-type 'type) (accept-forwarded-type fwd-expr context))
        ((eq fwd-type 'func) (accept-forwarded-func fwd-expr context))
        (t (error "unknown token"))
        ))))

; =================================================
; accepts expession and dispatches it's content
(defun accept-expr (expr context)
  (unless (listp expr)
    (error "expr is not a list"))
  (let ((func-token (car expr)))
    (cond
      ((eq func-token 'forwards) (accept-forwards (cdr expr) context))
      (t (format t "unknown "))))
  (format t "expr token = ~a~%" (car expr))
  )

; =================================================
; analyzing file contents
(defun analyze1 (file-name)
  (let ((context (make-empty-analyzer-context)))
    (with-open-file (in-stream file-name
                               :direction :input
                               :if-does-not-exist :error)
      (loop for expr = (read in-stream nil)
            until (null expr)
            do (progn
                 ; (format t "~a~%" expr)
                 (accept-expr expr context))))))



; =================================================
; test loader
(defun load-from-stream ()
  (with-input-from-string (in-stream "(this is a test)")
    (let ((l (read in-stream)))
      (format t "l = ~a~%" l)
      )
    ))

; =================================================
; reads a stream until nil met (or stream ends)
(defun load2 ()
  (with-input-from-string (in-stream "a b (c d) e")
    (do ((s (read in-stream nil) (read in-stream nil))) ((null s))
      (format t "s = ~a~%" s))))

; =================================================
; reads stream as well
(defun load3 ()
  (format t "~%#~4tExpression~20tType~%")
  (format t "============================~%")
  (with-input-from-string (in-stream "a b (c d) nil t 1 12 'utter 2/3 3.0 e")
    (loop for expr = (read in-stream nil 'eof)
          for pos from 1
          until (eq expr 'eof)
          do (format t "~a~4t~a~20t~a~%" pos expr (type-of expr))))
  (format t "============================~%"))


(defun main ()
  (format t "asd2")
  )

